home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0019_General Input Routine.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  5KB  |  190 lines
  1. {$IFDEF VER70}
  2. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}
  3. {$ELSE}
  4. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}
  5. {$ENDIF}
  6. {$M 8192,0,0}
  7.  
  8. Unit Edit;
  9.  
  10. INTERFACE
  11.  
  12. Uses Crt;
  13.  
  14. Const
  15.   BS   =  #8;
  16.   CR   = #13;
  17.   SP   = #32;
  18.   Esc  = #27;
  19.  
  20.   LeftKey  = #75;     HomeKey = #71;
  21.   RightKey = #77;     EndKey  = #79;
  22.   InsKey   = #82;     DelKey  = #83;
  23.  
  24. Procedure GetString(Size : Byte ; Var Str : String;Fill : Char);
  25.  
  26. IMPLEMENTATION
  27.  
  28. {----------------------------------------------------------------------------}
  29.  
  30. Procedure GetString(Size : Byte ; Var Str: String;Fill : Char);
  31.  
  32.   Var
  33.     CurrLen   : Byte absolute Str;
  34.     X, Y,
  35.     CurrPos   : Byte;
  36.     Insert    : Boolean;
  37.     I         : Integer;
  38.     T         : Char;
  39.  
  40.   Begin   {GetString}
  41.     Insert  := True;
  42.     X       := WhereX;                                 {X-pos of first char}
  43.     Y       := WhereY;
  44.     CurrLen := 0;
  45.     CurrPos := 0;                                 {position of current char}
  46.     Repeat
  47.       GotoXY(X,Y);
  48.       Write(Str);
  49.       For I := CurrLen+1 To Size Do 
  50.         Write(Fill);                                    {filler on screen}
  51.       GotoXY(X+CurrPos,Y);
  52.       T := ReadKey;
  53.       If T = #0 Then             {special keys <-, ->, Ins, Home, End, Del}
  54.         Begin   {If}
  55.           T := ReadKey;
  56.           Case T Of
  57.             LeftKey  : If CurrPos > 0 Then Dec(CurrPos);
  58.             RightKey : If (CurrPos < CurrLen) And
  59.                           (CurrPos < Size) Then
  60.                             Inc(CurrPos);
  61.             InsKey   : Insert := Not Insert;
  62.             HomeKey  : CurrPos := 0;
  63.             EndKey   : CurrPos := CurrLen;
  64.             DelKey   : If CurrLen > CurrPos Then
  65.                          Begin   {If}
  66.                            For I := CurrPos+1 To CurrLen-1 Do 
  67.                              Str[I] := Str[I+1];
  68.                            Dec(CurrLen)
  69.                          End    {If}
  70.           End    {Case T Of}
  71.         End    {If}
  72.       Else
  73.         Begin   {Else}
  74.           Case T Of
  75.             BS       : If CurrPos > 0 Then                {delete currpos}
  76.                          Begin   {If}
  77.                            For I := CurrPos To CurrLen-1 Do 
  78.                              Str[i] := Str[i+1];
  79.                            Dec(CurrPos);
  80.                            Dec(CurrLen)
  81.                          End;    {If}
  82.             SP..'~'  : If CurrLen < Size Then          {add new character}
  83.                          Begin   {If}
  84.                            Inc(CurrPos);
  85.                            If insert Then
  86.                              Begin   {If}
  87.                                For I := CurrLen DownTo CurrPos Do
  88.                                  Str[i+1] := Str[i];
  89.                                Inc(CurrLen)
  90.                              End;
  91.                            Str[CurrPos] := T
  92.                          End;    {If}
  93.           End;   {Case T Of}
  94.         End;   {Else}
  95.     Until (T = CR) or (T = Esc);
  96.     If T = Esc Then
  97.       Halt;
  98.     WriteLn;
  99.   End    {GetString};
  100.  
  101. {----------------------------------------------------------------------------}
  102.  
  103. End.    {Edit Unit}
  104.  
  105. Program TestEdit;
  106.  
  107. Uses
  108.    Crt,
  109.    Edit;
  110.  
  111. Type
  112.    TRec      = Record
  113.       First,
  114.       Mid,
  115.       Last,
  116.       Add,
  117.       City,
  118.       State,
  119.       Zip    : String;
  120.    End;    {TRec}
  121.  
  122. Var
  123.    T    : TRec;
  124.    Ch,
  125.    Fill : Char;
  126.  
  127. {----------------------------------------------------------------------------}
  128.  
  129. Procedure Init(Var T : TRec);
  130.  
  131.    Begin   {Init}
  132.       T.Last     := '';
  133.       T.Mid      := '';
  134.       T.First    := '';
  135.       T.Add      := '';
  136.       T.City     := '';
  137.       T.State    := '';
  138.       T.Zip      := '';
  139.    End;    {Init}
  140.  
  141. {----------------------------------------------------------------------------}
  142.  
  143. Begin   {Main}
  144.    Fill := '▒';
  145.    Init(T);
  146.    TextBackGround(Blue);
  147.    TextColor(15);
  148.    ClrScr;
  149.    GotoXY(1,5);
  150.    Write('FIRST NAME  : ');
  151.    TextColor(7);
  152.    GetString(20, T.First, Fill);
  153.    TextColor(15);
  154.    Write('MIDDLE NAME : ');
  155.    TextColor(7);
  156.    GetString(20, T.Mid, Fill);
  157.    TextColor(15);
  158.    Write('LAST NAME   : ');
  159.    TextColor(7);
  160.    GetString(20, T.Last, Fill);
  161.    TextColor(15);
  162.    Write('ADDRESS     : ');
  163.    TextColor(7);
  164.    GetString(40, T.Add, Fill);
  165.    TextColor(15);
  166.    Write('CITY        : ');
  167.    TextColor(7);
  168.    GetString(30, T.City, Fill);
  169.    TextColor(15);
  170.    Write('STATE       : ');
  171.    TextColor(7);
  172.    GetString(5, T.State, Fill);
  173.    TextColor(15);
  174.    Write('ZIP-CODE    : ');
  175.    TextColor(7);
  176.    GetString(10, T.Zip, Fill);
  177.    TextBackGround(Black);
  178.    TextColor(LightGray);
  179.    ClrScr;
  180.    GotoXY(1,5);
  181.    WriteLn(T.First,' ',T.Mid,' ',T.Last);
  182.    WriteLn(T.Add);
  183.    WriteLn(T.City,', ',T.State,'   ',T.Zip);
  184.    WriteLn;
  185.    WriteLn('Good-Bye');
  186.    WriteLn;
  187.    WriteLn('Press any key...');
  188.    Ch := ReadKey;
  189. End.    {Main}
  190.